module MdServer where

import Data.List
import Network.Socket
import Control.Concurrent
import Control.Concurrent.MVar
import Control.OldException
import System.IO
import Control.Monad (forM)
import System.Directory
import Data.Maybe
import System.FilePath.Posix (splitExtension)
--binary lazy bytestring for file transfers
import qualified Data.ByteString.Lazy as LB
--textoriented strict bytestring
import qualified Data.ByteString.Char8 as ST
import qualified MetaUI as MU
import MetaMongo
import FlsParser
import Database.MongoDB


type ServeFunc = MVar () -> Socket -> SockAddr -> IO ()
type Port = String


--Edit this function for appropriate functionality for analyzer.
processMasterCMD lock line connhdl clientaddr pool =
	case cmd of
	     "load" -> performLoad lock connhdl clientaddr pool line'
	     "tlc" -> performTLC lock connhdl clientaddr pool line' -- complete timeline
	     "tlr" -> performTLR lock connhdl clientaddr pool line' -- takes seconds
	     "distrcmp" -> performDCMP lock connhdl clientaddr pool line' --takes int, and grabs name auto
	     "ledCorr" -> performLEDCorr lock connhdl clientaddr pool line' -- takes int, and grabs name auto
	     "tsCorr" -> performTSCorr lock connhdl clientaddr pool line' --takes int grabs name
	     "sed" -> performSED lock connhdl clientaddr pool line' -- takes int, grabs name... could make it take reg name
	     "tsdir" -> performTSDIR lock connhdl clientaddr pool line'
	     "eddir" -> performEDDIR lock connhdl clientaddr pool line'
	     _ -> return ()
	where
	  cmd = ST.unpack (head (ST.words line))
	  line' = ST.unpack line

--load Name size::Integer
performLoad lock connhdl clientaddr pool line =
    do printMsg lock clientaddr "performing Load command"
       cmdName <- hGetLine connhdl
       if ((length (words cmdName)) <= 3)
        then do hPutStrLn connhdl "err not enough params"
                printMsg lock clientaddr "load error: bad params"
        else do size <- size' cmdName
                if (size == (-1))
                    then do hPutStrLn connhdl "err bad size"
                            printMsg lock clientaddr "load error: bad size"
                    else do contents <- LB.hGet connhdl size
                            LB.writeFile ("testData/" ++ ((words cmdName)!!2)) contents
                            bodyfile <- MU.getFile ("testData/" ++ ((words cmdName)!!2))
                            let bls = maybeParseB bodyfile
                                in if isNothing bls
                                        then do hPutStrLn connhdl "err bad fls file"
                                                printMsg lock clientaddr "load error: bad fls file"
                                        else do let bls' = fromJust bls
                                                    in startDB bls' pool
                                                fh <- openFile "testData/Initial" ReadMode
                                                initContents <- LB.hGetContents fh
                                                LB.hPutStr connhdl initContents
     where
        size' s = handle (intError) (return (Prelude.read ((words s)!!3)::Int))

--do error handling here...
performEDDIR lock connhdl clientaddr pool line =
      do lineNum <- ln
         lineNum1 <- ln1
         if ((tail (words line)) ==[])
           then do printMsg lock clientaddr "EDDIR: Error no parameters"
                   hPutStrLn connhdl "err"
           else do printMsg lock clientaddr "performing EditDistance between two dirs"
                   if ((lineNum == (-1)) || (lineNum1 == (-1)))
                        then do hPutStrLn connhdl "err integer"
                                printMsg lock clientaddr "EditDistanceCorrDir bad args"
                        else do name <- MU.grabName lineNum
                                name2 <- MU.grabName lineNum1
                                doEditDistanceCorrDir name name2 pool connhdl
                                printMsg lock clientaddr "EditDistanceCorrDir complete"
               where
                    ln = handle (intError) (return (Prelude.read ((words line)!!1)::Int))
                    ln1 = handle (intError) (return (Prelude.read ((words line)!!2)::Int))


performTSDIR lock connhdl clientaddr pool line =
    do  lineNum <- ln
        lineNum1 <- ln1
        if ((tail (words line)) == [])
            then do printMsg lock clientaddr "EDDIR: Error no parameters"
                    hPutStrLn connhdl "err"
            else do printMsg lock clientaddr "Performing TimeStamp Correlation between two dirs"
                    if ((lineNum == (-1)) || (lineNum1 == (-1)))
                        then do hPutStrLn connhdl "err Integer"
                                printMsg lock clientaddr "TSDIR bad args"
                        else do name <- MU.grabName lineNum
                                name2 <- MU.grabName lineNum1
                                doTimeStampCorrDir name name2 pool connhdl
                                printMsg lock clientaddr "TimestampCorrDir complete"
               where
                    ln = handle (intError) (return (Prelude.read ((words line)!!1) ::Int))
                    ln1 = handle (intError) (return (Prelude.read ((words line)!!2) ::Int))


performSED lock connhdl clientaddr pool line =
    do  lineNum <- ln
        if ((tail (words line)) == [])
            then do printMsg lock clientaddr "SED: Error no parameters"
                    hPutStrLn connhdl "err"
            else do if (lineNum == (-1))
                        then do hPutStrLn connhdl "err Integer"
                                printMsg lock clientaddr "SED: error bad args"
                        else do name <- MU.grabName lineNum
                                doSimpleEditDistance name pool connhdl
                                printMsg lock clientaddr "SimpleEditDistance complete"
        where
            ln = handle (intError) (return (Prelude.read ((words line)!!1) :: Int))

performTSCorr lock connhdl clientaddr pool line =
    do  lineNum <- ln
        if ((tail (words line)) == [])
            then do printMsg lock clientaddr "TSCorr: error no parameters"
                    hPutStrLn connhdl "err"
            else do if (lineNum == (-1))
                        then do hPutStrLn connhdl "err Integer"
                                printMsg lock clientaddr "TSCorr: error bad args"
                        else do name <- MU.grabName lineNum
                                doTimestampCorr name pool connhdl
                                printMsg lock clientaddr "TSCorr complete"
        where
            ln = handle (intError) (return (Prelude.read ((words line)!!1) ::Int))

performLEDCorr lock connhdl clientaddr pool line =
    do  lineNum <- ln
        if ((tail (words line)) == [])
            then do printMsg lock clientaddr "LEDCorr: error no parameters"
                    hPutStrLn connhdl "err"
            else do if (lineNum == (-1))
                        then do hPutStrLn connhdl "err Integer"
                                printMsg lock clientaddr ("LEDCorr: bad args integer")
                        else do name <- MU.grabName lineNum
                                doEditDistance name pool connhdl
                                printMsg lock clientaddr ("EditDistance Complete" ++ name)
        where
            ln = handle (intError) (return (Prelude.read ((words line)!!1) ::Int))

performDCMP lock connhdl clientaddr pool line =
    do  lineNum <- ln
        if ((tail (words line)) == [])
            then do printMsg lock clientaddr "DCMP: error no parameters"
                    hPutStrLn connhdl "err"
            else do if (lineNum == (-1))
                        then do hPutStrLn connhdl "err Integer"
                                printMsg lock clientaddr "DCMP:error bad args"
                        else do name <- MU.grabName lineNum
                                doCmpDistr name pool connhdl
                                printMsg lock clientaddr ("DistributionCmp Complete" ++ name)
        where
            ln = handle (intError) (return (Prelude.read ((words line) !! 1) ::Int))

performTLC lock connhdl clientaddr pool line =
    do (doCompleteTimeline pool connhdl)
       printMsg lock clientaddr "TLC-Complete"

performTLR lock connhdl clientaddr pool line =
    do  seconds <- ss
        if ((tail (words line)) == [])
            then do printMsg lock clientaddr "TLR: error no parameters"
                    hPutStrLn connhdl "err"
            else do if (seconds == -1)
                        then do hPutStrLn connhdl "err Integer"
                                printMsg lock clientaddr "TLR: error integer"
                        else do (doTimelineRange seconds pool connhdl)
                                printMsg lock clientaddr "TLR-Complete"
        where
            ss = handle (integerError) (return (Prelude.read ((words line) !! 1) :: Integer))
            integerError e = return (-1)

intError :: Exception -> IO (Int)
intError e = return (-1)

startDB bls pool =
    do doClearDB pool
       doLoadBodyFile pool bls
       print "BodyFile loaded!!"
       doTimelineSetup pool
       print "Timeline file setup"
       print "starting to calculate distributions"
       doCalcDistribution pool
       print "distributions complete"

initServer p =
	do lock <- newMVar ()
	   pipe <- runIOE $ Database.MongoDB.connect (host "127.0.0.1")
	   initMaster p lock pipe

-- Init MasterListener	
initMaster port lock pool =
	do listenForConn port lock "MasterListener" (serveMaster pool)

-- general function for listening on a server socket, and spawning threads to serve clients
-- executes ServeFunc on each connection
listenForConn ::  Port -> MVar () -> String -> ServeFunc -> IO ()
listenForConn portNum lock name serve  = withSocketsDo $
	do
	  addrinfos <- getAddrInfo
	               (Just (defaultHints {addrFlags = [AI_PASSIVE]}))
	               Nothing (Just portNum)

	  let serveraddr = head addrinfos
	  printMsg lock (SockAddrUnix "localhost") (name ++ "initalizing")
	  sock <- socket (addrFamily serveraddr) Stream defaultProtocol
	  bindSocket sock (addrAddress serveraddr)
	  listen sock 30
	  procRequests lock sock name
	
	where
          -- | Process incoming connection requests
          procRequests :: MVar () -> Socket -> String -> IO ()
          procRequests lock mastersock name =
              do (connsock, clientaddr) <- accept mastersock
                 printMsg lock clientaddr
                    (name ++ ": client connected")
                 forkIO $ serve lock connsock clientaddr
                 procRequests lock mastersock name


-- ServeFunc for handling Master Requests
serveMaster pool lock connsock clientaddr =
	do connhdl <- socketToHandle connsock ReadWriteMode
	   hSetBuffering connhdl LineBuffering
	   command <- ST.hGetLine connhdl
	   processMasterCMD lock command connhdl clientaddr pool
	   hClose connhdl
	   printMsg lock clientaddr "MasterListener: master disconnected"

-- Lock the handler before passing data to it.
-- uncomment and remove return for debugging.
printMsg :: MVar () -> SockAddr -> String -> IO ()
printMsg lock clientaddr msg = withMVar lock (\a -> myDebug clientaddr msg >> return a)

myDebug :: SockAddr -> String -> IO ()
myDebug addr msg =
    putStrLn $ "From " ++ show addr ++ ": " ++ msg

sendMsg :: Handle -> String -> IO ()
sendMsg h msg =
	do hPutStrLn h msg
	   hFlush h
